home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / SieveN.ctl < prev    next >
Text File  |  1997-06-14  |  4KB  |  135 lines
  1. VERSION 5.00
  2. Begin VB.UserControl XSieveN 
  3.    BorderStyle     =   1  'Fixed Single
  4.    ClientHeight    =   630
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   645
  8.    BeginProperty Font 
  9.       Name            =   "Tahoma"
  10.       Size            =   7.5
  11.       Charset         =   0
  12.       Weight          =   700
  13.       Underline       =   0   'False
  14.       Italic          =   0   'False
  15.       Strikethrough   =   0   'False
  16.    EndProperty
  17.    ScaleHeight     =   648
  18.    ScaleMode       =   0  'User
  19.    ScaleWidth      =   648
  20.    ToolboxBitmap   =   "SieveN.ctx":0000
  21.    Begin VB.Label lbl 
  22.       Caption         =   "Sieve"
  23.       Height          =   204
  24.       Left            =   36
  25.       TabIndex        =   0
  26.       Top             =   24
  27.       Width           =   540
  28.    End
  29.    Begin VB.Image img 
  30.       Height          =   225
  31.       Left            =   45
  32.       Picture         =   "SieveN.ctx":00FA
  33.       Top             =   255
  34.       Width           =   240
  35.    End
  36. End
  37. Attribute VB_Name = "XSieveN"
  38. Attribute VB_GlobalNameSpace = False
  39. Attribute VB_Creatable = True
  40. Attribute VB_PredeclaredId = False
  41. Attribute VB_Exposed = True
  42. Option Explicit
  43.  
  44. Private af() As Boolean, iCur As Integer
  45. Private iMaxPrime As Integer, cPrime As Integer
  46.  
  47. Private Sub UserControl_Initialize()
  48.     Debug.Print "UserControl_Initialize"
  49. End Sub
  50.  
  51. ' Initialize Properties for User Control
  52. Private Sub UserControl_InitProperties()
  53.     ' Default size is largest integer
  54.     iMaxPrime = 32766
  55. End Sub
  56.  
  57. ' Load property values from storage
  58. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  59.     iMaxPrime = PropBag.ReadProperty("MaxPrime", 32766)
  60. End Sub
  61.  
  62. ' Write property values to storage
  63. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  64.     Call PropBag.WriteProperty("MaxPrime", iMaxPrime, 32766)
  65. End Sub
  66.  
  67. Private Sub UserControl_Show()
  68.     ReInitialize
  69.     If Ambient.UserMode Then Extender.Visible = False
  70. End Sub
  71.  
  72. Private Sub UserControl_Resize()
  73.     Width = lbl.Width
  74.     Height = lbl.Width
  75. End Sub
  76.  
  77. Sub ReInitialize()
  78.     ReDim af(0 To iMaxPrime)
  79.     iCur = 1: cPrime = 0
  80. End Sub
  81.  
  82. Property Get NextPrime() As Integer
  83. Attribute NextPrime.VB_MemberFlags = "400"
  84.     NextPrime = 0
  85.     ' Loop until we find a prime or overflow array
  86.     iCur = iCur + 1
  87.     On Error GoTo OverMaxPrime
  88.     Do While af(iCur)
  89.         iCur = iCur + 1
  90.     Loop
  91.     ' Cancel multiples of this prime
  92.     Dim i As Long
  93.     For i = iCur + iCur To iMaxPrime Step iCur
  94.         af(i) = True
  95.     Next
  96.     ' Count and return it
  97.     cPrime = cPrime + 1
  98.     NextPrime = iCur
  99. OverMaxPrime:       ' Array overflow comes here
  100. End Property
  101.  
  102. Property Get MaxPrime() As Integer
  103.     MaxPrime = iMaxPrime
  104. End Property
  105.  
  106. Property Let MaxPrime(iMaxPrimeA As Integer)
  107.     iMaxPrime = iMaxPrimeA
  108.     ReInitialize
  109.     PropertyChanged "MaxPrime"
  110. End Property
  111.  
  112. Property Get Primes() As Integer
  113. Attribute Primes.VB_MemberFlags = "400"
  114.     Primes = cPrime
  115. End Property
  116.  
  117. Sub AllPrimes(ai() As Integer)
  118.     If LBound(ai) <> 0 Then Exit Sub
  119.     iMaxPrime = UBound(ai)
  120.     cPrime = 0
  121.     Dim i As Integer
  122.     For iCur = 2 To iMaxPrime
  123.         If Not af(iCur) Then    ' Found a prime
  124.             For i = iCur + iCur To iMaxPrime Step iCur
  125.                 af(i) = True    ' Cancel its multiples
  126.             Next
  127.             ai(cPrime) = iCur
  128.             cPrime = cPrime + 1
  129.         End If
  130.     Next
  131.     ReDim Preserve ai(0 To cPrime) As Integer
  132.     iCur = 1
  133. End Sub
  134.  
  135.